home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / alfresco / AA6Pack.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-01-30  |  6.1 KB  |  192 lines
  1. {*********************************************************}
  2. {* AA6Pack                                               *}
  3. {* Copyright (c) Julian M Bucknall 1999                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* SixBitPack compression and decompression              *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AA6Pack;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils, Classes;
  19.  
  20. {$IFOPT D+}
  21. {$DEFINE InDebugMode}
  22. {$ENDIF}
  23.  
  24. procedure SixBitPackCompress(aInStream, aOutStream : TStream);
  25. procedure SixBitPackDecompress(aInStream, aOutStream : TStream);
  26.  
  27. implementation
  28.  
  29. const
  30.   AcceptedChars : string[63] =
  31.                   'abcdefghijklmnopqrstuvwxyz' + {26}
  32.                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + {52}
  33.                   ' .,;:-()!'^M^J;               {63}
  34. const
  35.   Escape = $00;
  36.   EndOfData = byte('Z');
  37.  
  38. {===Helper routines==================================================}
  39. function ReadBits(aBitCount : integer;
  40.                   aStream   : TStream;
  41.               var aCollByte : byte;
  42.               var aCollCount: integer) : byte;
  43. const
  44.   Masks : array [0..7] of byte =
  45.           ($01, $02, $04, $08, $10, $20, $40, $80);
  46. var
  47.   i       : integer;
  48.   TempCollByte  : byte;
  49.   TempCollCount : integer;
  50.   BytesRead     : longint;
  51. begin
  52.   {make temporary copies of the var parameters for speed}
  53.   TempCollByte := aCollByte;
  54.   TempCollCount := aCollCount;
  55.   {clear resulting byte}
  56.   Result := 0;
  57.   {for all bits...}
  58.   for i := 0 to pred(aBitCount) do begin
  59.     {if we've run out of bits, get another byte from the stream}
  60.     if (TempCollCount = 0) then begin
  61.       BytesRead := aStream.Read(TempCollByte, 1);
  62.       if (BytesRead <> 1) then
  63.         raise Exception.Create('Input stream is exhausted, expecting more data');
  64.       TempCollCount := 8;
  65.     end;
  66.     {shift result to accept next bit (sets low bit to zero)}
  67.     Result := Result shl 1;
  68.     {get topmost bit from collector byte}
  69.     if ((TempCollByte and $80) <> 0) then
  70.       Result := Result or 1;
  71.     {we've used another bit}
  72.     TempCollByte := TempCollByte shl 1;
  73.     dec(TempCollCount);
  74.   end;
  75.   {set new values of var parameters}
  76.   aCollByte := TempCollByte;
  77.   aCollCount := TempCollCount;
  78. end;
  79. {--------}
  80. procedure WriteBits(aValue    : byte;
  81.                     aBitCount : integer;
  82.                     aStream   : TStream;
  83.                 var aCollByte : byte;
  84.                 var aCollCount: integer);
  85. const
  86.   Masks : array [0..7] of byte =
  87.           ($01, $02, $04, $08, $10, $20, $40, $80);
  88. var
  89.   MaskInx : integer;
  90.   i       : integer;
  91.   TempCollByte  : byte;
  92.   TempCollCount : integer;
  93. begin
  94.   {make temporary copies of the var parameters for speed}
  95.   TempCollByte := aCollByte;
  96.   TempCollCount := aCollCount;
  97.   {start off with the correct mask}
  98.   MaskInx := pred(aBitCount);
  99.   {for all bits...}
  100.   for i := 0 to pred(aBitCount) do begin
  101.     {shift collector byte left by one (sets low bit to zero)}
  102.     TempCollByte := TempCollByte shl 1;
  103.     {if the current bit is set, set low bit of the collector byte}
  104.     if (aValue and Masks[MaskInx]) <> 0 then
  105.       TempCollByte := TempCollByte or 1;
  106.     {we've added one more bit}
  107.     inc(TempCollCount);
  108.     {if the collector byte is full, write it out, reset bit count}
  109.     if (TempCollCount = 8) then begin
  110.       aStream.Write(TempCollByte, 1);
  111.       TempCollCount := 0;
  112.     end;
  113.     {get next mask}
  114.     dec(MaskInx);
  115.   end;
  116.   {set new values of var parameters}
  117.   aCollByte := TempCollByte;
  118.   aCollCount := TempCollCount;
  119. end;
  120. {====================================================================}
  121.  
  122.  
  123. {===Interfaced routines==============================================}
  124. procedure SixBitPackCompress(aInStream, aOutStream : TStream);
  125. var
  126.   CollectorByte : byte;
  127.   BitCount      : integer;
  128.   BytesRead     : longint;
  129.   Encoding      : byte;
  130.   Ch            : byte;
  131. begin
  132.   {we've collected no bits so far}
  133.   BitCount := 0;
  134.   {get the first character from the input stream}
  135.   BytesRead := aInStream.Read(Ch, 1);
  136.   {repeat until we run out of characters in the input stream}
  137.   while (BytesRead > 0) do begin
  138.     {get the possible encoding for this character}
  139.     Encoding := Pos(char(Ch), AcceptedChars);
  140.     {write it out (note: we assume that Escape is 0 here)}
  141.     WriteBits(Encoding, 6, aOutStream, CollectorByte, BitCount);
  142.     {if the encoding is zero, the character wasn't found, so output
  143.      the actual character}
  144.     if (Encoding = 0) then
  145.       WriteBits(Ch, 8, aOutStream, CollectorByte, BitCount);
  146.     {get the next byte}
  147.     BytesRead := aInStream.Read(Ch, 1)
  148.   end;
  149.   {output the end-of-data marker}
  150.   WriteBits(Escape, 6, aOutStream, CollectorByte, BitCount);
  151.   WriteBits(EndOfData, 8, aOutStream, CollectorByte, BitCount);
  152.   {if we've some bits left over write them out as well}
  153.   if (BitCount <> 0) then begin
  154.     {shift the bits to the top of the byte}
  155.     CollectorByte := CollectorByte shl (8 - BitCount);
  156.     aOutStream.Write(CollectorByte, 1);
  157.   end;
  158. end;
  159. {--------}
  160. procedure SixBitPackDecompress(aInStream, aOutStream : TStream);
  161. var
  162.   CollectorByte : byte;
  163.   BitCount      : integer;
  164.   EncodedChar   : byte;
  165.   Finished      : boolean;
  166.   Ch            : byte;
  167. begin
  168.   {we've got no bits to decompress yet}
  169.   BitCount := 0;
  170.   {repeat until we hit the end-of-data marker}
  171.   Finished := false;
  172.   while not Finished do begin
  173.     {get the next encoded character}
  174.     EncodedChar := ReadBits(6, aInStream, CollectorByte, BitCount);
  175.     {check for the escape character}
  176.     if (EncodedChar <> Escape) then
  177.       {..normal character}
  178.       aOutStream.Write(AcceptedChars[EncodedChar], 1)
  179.     else begin
  180.       {..escaped character}
  181.       Ch := ReadBits(8, aInStream, CollectorByte, BitCount);
  182.       if (Ch = EndOfData) then
  183.         Finished := true
  184.       else
  185.         aOutStream.Write(Ch, 1)
  186.     end;
  187.   end;
  188. end;
  189. {====================================================================}
  190.  
  191. end.
  192.